home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / utils / ted / tedtro4.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-10-02  |  6.0 KB  |  211 lines
  1. {
  2.                           Coding & Editing by :
  3.         █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀▀█ █▀▀▀▀▀█ █ █▀▀▀▀▀▀▀ █▀▀▀▀▀▀▀
  4.         █▀▀▀▀▀▀▀ █▀▀▀▀▀▀█ █▀▀▀▀▀█▀ █▀▀▀▀▀▀█ █     █ █ ▀▀▀▀▀▀▀█ █▀▀▀▀▀
  5.         █        █      █ █      █ █      █ █     █ █        █ █
  6.         █        █      █ █      █ █      █ █     █ █        █ █
  7.         █        █      █ █      █ █      █ █     █ █        █ █
  8.         █        █      █ █      █ █      █ █▄▄▄▄▄█ █ ▄▄▄▄▄▄▄█ █▄▄▄▄▄▄▄
  9.  
  10.         Programmed by Marcin Jaskowiak, aka Paradise, Lublin, Poland,
  11.                           in Turbo Pascal 7.0.
  12.  
  13.         This is FUQNWARE - if u like it, u must register it by sending
  14.         some money (u tell how much) to ME:) if not - u choose.
  15.         Read TED.DOC 4 more info.
  16.  
  17.         Snail mail:                      Email:
  18.         Marcin Jaskowiak                 liksay@bachus.umcs.lublin.pl
  19.         Flat 114, 3 Zarnowiecka Str.
  20.         20-630 Lublin
  21.         Poland
  22.  
  23.                                Presents :
  24.                     TED font editor SCROLLERS PACK 94
  25.                                 with :
  26.                              EXAMPLE NR 4
  27. }
  28. PROGRAM TED_INTRO_NR4;
  29. USES DOS,CRT;
  30.  
  31. CONST
  32.  SEGA000        : WORD = $A000;
  33. VAR
  34.  BITMAP         : ARRAY [1..60,0..319] OF BYTE;
  35.  PALETTE        : ARRAY [0..255,1..3] OF BYTE;
  36.  CHARS          : ARRAY [' '..']'] OF POINTER;
  37.  CHARSDATA      : ARRAY [' '..']',1..3] OF BYTE;
  38.  F              : FILE;
  39.  B,ROW,NR       : BYTE;
  40.  X,Y,I,J        : INTEGER;
  41.  CH,K           : CHAR;
  42.  TEKST          : STRING;
  43.  SINUS          : ARRAY [0..255] OF BYTE;
  44.  SINN           : BYTE;
  45.  
  46. {───────────────────────────────────────────────────────────────────────────}
  47. PROCEDURE CALCSIN;
  48. VAR I : INTEGER;
  49. BEGIN
  50.  FOR I := 0 TO 255 DO SINUS[I] := ROUND(SIN(5*I*PI/155)*45)+70;
  51. END;
  52. {───────────────────────────────────────────────────────────────────────────}
  53. PROCEDURE INITVGA; ASSEMBLER; { INITIALIZE VGA CARD MODE 13H }
  54. ASM
  55.  MOV AX,0013H
  56.  INT 10H
  57. END;
  58. {───────────────────────────────────────────────────────────────────────────}
  59. PROCEDURE CLOSEVGA; ASSEMBLER; { CLOSE VGA MODE AND SET TEXT }
  60. ASM
  61.  MOV AX,0003H
  62.  INT 10H
  63. END;
  64. {───────────────────────────────────────────────────────────────────────────}
  65. PROCEDURE VSYNC; ASSEMBLER;
  66. ASM
  67.  MOV DX,03DAH
  68.  @@1: IN AL,DX; TEST AL,8; JNZ @@1;
  69.  @@2: IN AL,DX; TEST AL,8; JZ  @@2;
  70. END;
  71. {───────────────────────────────────────────────────────────────────────────}
  72. PROCEDURE DRAWBITMAP(OFSiI: WORD); ASSEMBLER;
  73. ASM
  74.  MOV DI,OFSiI
  75.  MOV ES,SEGA000
  76.  MOV SI,OFFSET BITMAP
  77.  MOV CX,9600
  78.  CLD
  79.  REP MOVSW
  80. END;
  81. {───────────────────────────────────────────────────────────────────────────}
  82. PROCEDURE SCROLLBITMAP(VAR MAP); ASSEMBLER;
  83. ASM
  84.   LDS SI,MAP
  85.   LES DI,MAP
  86.   INC SI
  87.   INC SI
  88.   MOV CX,9600
  89.   REP MOVSW
  90. END;
  91. {───────────────────────────────────────────────────────────────────────────}
  92. PROCEDURE SETCOLOR(NR,R,G,B: BYTE); ASSEMBLER; { SET RGB VAL TO COLOR NR }
  93. ASM
  94.  MOV DX,3C8H
  95.  MOV AL,NR
  96.  OUT DX,AL
  97.  INC DX
  98.  MOV AL,R
  99.  OUT DX,AL
  100.  MOV AL,G
  101.  OUT DX,AL
  102.  MOV AL,B
  103.  OUT DX,AL
  104. END;
  105. {───────────────────────────────────────────────────────────────────────────}
  106. PROCEDURE LOADPAL(NAME: STRING); { LOAD .PAL FILE AND SET PALETTE }
  107. BEGIN
  108.  ASSIGN(F,NAME+'.PAL');
  109.  RESET(F,1);
  110.  BLOCKREAD(F,PALETTE,768);
  111.  CLOSE(F);
  112.  FOR B:=0 TO 255 DO SETCOLOR(B,PALETTE[B,1],PALETTE[B,2],PALETTE[B,3]);
  113. END;
  114. {───────────────────────────────────────────────────────────────────────────}
  115. PROCEDURE LOADTED(NAME: STRING); { LOAD .TED FILE TO MEMORY }
  116. VAR TX,TY: BYTE; CH: CHAR;
  117. BEGIN
  118.  ASSIGN(F,NAME+'.TED');
  119.  RESET(F,1);
  120.  SEEK(F,20);
  121.  WHILE NOT(EOF(F)) DO
  122.  BEGIN
  123.   BLOCKREAD(F,CH,1);
  124.   BLOCKREAD(F,TX,1);
  125.   BLOCKREAD(F,TY,1);
  126.   GETMEM(CHARS[CH],TX*TY);
  127.   CHARSDATA[CH,1]:=TX; CHARSDATA[CH,2]:=TY; CHARSDATA[CH,3]:=1;
  128.   BLOCKREAD(F,CHARS[CH]^,TX*TY);
  129.  END;
  130.  CLOSE(F);
  131.  IF CHARSDATA[' ',3]<>1 THEN { IF NOT SPACE " " THEN CREATE IT }
  132.  BEGIN
  133.   TX:=CHARSDATA['A',1];
  134.   TY:=CHARSDATA['A',2];
  135.   GETMEM(CHARS[' '],TX*TY);
  136.   FILLCHAR(CHARS[' ']^,TX*TY,0);
  137.   CHARSDATA[' ',3]:=1;
  138.   CHARSDATA[' ',1]:=TX;
  139.   CHARSDATA[' ',2]:=TY;
  140.  END;
  141. END;
  142. {───────────────────────────────────────────────────────────────────────────}
  143. PROCEDURE DONETED; { DEALLOCATE FONT MEMORY }
  144. VAR CH: CHAR;
  145. BEGIN
  146.  FOR CH:=' ' TO ']' DO
  147.  BEGIN
  148.   IF CHARSDATA[CH,3]=1 THEN
  149.   BEGIN
  150.    FREEMEM(CHARS[CH],CHARSDATA[CH,1]*CHARSDATA[CH,2]);
  151.    CHARSDATA[CH,3]:=0;
  152.   END;
  153.  END;
  154. END;
  155. {───────────────────────────────────────────────────────────────────────────}
  156. PROCEDURE NEWROW(CH: CHAR; RO: BYTE; POS: INTEGER); { DRAW HORIZ LINE }
  157. VAR TX,TY,IC: INTEGER;
  158. BEGIN
  159.  IF CHARSDATA[CH,3]<>1 THEN EXIT; { EXIT IF NO CHAR IN FONT }
  160.  IC:=(60-CHARSDATA[CH,2]) DIV 2; { START OF PIC IN "BITMAP" }
  161.  FOR TY:=1 TO 60 DO BITMAP[TY,POS]:=0;
  162.  IF RO=CHARSDATA[CH,1]+1 THEN
  163.   FOR TY:=1 TO CHARSDATA[CH,2] DO BITMAP[TY+IC,POS]:=0 { SKIP ONE ROW }
  164.  ELSE
  165.   FOR TY:=1 TO CHARSDATA[CH,2] DO
  166.    BITMAP[TY+IC,POS]:=MEM[SEG(CHARS[CH]^):OFS(CHARS[CH]^)+(TY-1)*CHARSDATA[CH,1]+RO-1];
  167. END;
  168. {───────────────────────────────────────────────────────────────────────────}
  169. PROCEDURE UPDATE; { NEW VALUES ? }
  170. BEGIN
  171.  INC(ROW);
  172.  IF ROW>CHARSDATA[TEKST[NR],1]+1 THEN
  173.  BEGIN
  174.   ROW:=1;
  175.   INC(NR);
  176.   IF NR>LENGTH(TEKST) THEN NR:=1;
  177.  END;
  178. END;
  179. {───────────────────────────────────────────────────────────────────────────}
  180.  
  181.  
  182.  
  183. BEGIN
  184.  CALCSIN;
  185.  INITVGA;
  186.  LOADPAL('FONT099');
  187.  LOADTED('FONT099');
  188.  
  189.  ROW:=1;
  190.  TEKST:='NEXT SCROLL...   PASCAL RULEZ!!!!   '+
  191.         'GREETZ TO: MAX-Q.PJC.JASSE.DOOM.WELTI.SKAVEN.PMOTION.KRAVEN.XTOTO.ZOOMBAPUP.NUTCRACKER.'+
  192.         'MASON.ALL PRETTY GIRLS!.TECHNOMANCER.KARM.TONEDEF.KOLA ....OK ... NEXT KICKS GOES TO: JMAGIC.'+
  193.         'INK.MRF.RETROSPEC.MVP.ALL LAMERZ!......    C U !!                        ';
  194.  NR:=1;
  195.  SINN:=0;
  196.  FILLCHAR(BITMAP,SIZEOF(BITMAP),0);
  197.  
  198.  REPEAT
  199.   SCROLLBITMAP(BITMAP);
  200.   UPDATE;
  201.   NEWROW(TEKST[NR],ROW,318);
  202.   UPDATE;
  203.   NEWROW(TEKST[NR],ROW,319);
  204.   VSYNC;
  205.   DRAWBITMAP(SINUS[SINN]*320);
  206.   INC(SINN); IF SINN=62 THEN SINN:=0;
  207.  UNTIL KEYPRESSED;
  208.  
  209.  DONETED;
  210.  CLOSEVGA;
  211. END.